perm filename PICZ.F4[P,LCS] blob sn#085805 filedate 1974-02-03 generic text, type T, neo UTF8
00100		SUBROUTINE PLOU(NWW)
00200		COMMON/PLT/JX,JY,JPL,PLT,REV,RINV,ROT,RLR,RUD,CONST,E
00300		1 ,JREV,JINV,KA,KB,KC,KD,RTO,JA,JB,JAR,JBR,A,IA,IB,IC,ID
00400	C  KA-D IS FOR INVIS. INNER AREA.  IA-D IS FOR INVIS. OUTER AREA.
00500	
00510		COMMON/DRW/JDRW(2000)/FU/FUJ(512),JJX,RDIV,ADML
00555		EQUIVALENCE(JDRW,INP)
00600		COMMON/DDP/IDP1(4000)
00650		DIMENSION INP(10,200)
00700		COMMON/MEDGE/MC,MD,RMC,MMD/CLR/KP,KQ,KR,KS,P
00800		COMMON /LISTC/LIST(6,1000),LIST5(0/1000),NEWEND,LO
00900		COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
01000		1 LSIDE,RSIDE,DTA,HYSTAB(1)
01100		INTEGER FLINE,RSIDE
01200		DATA NEWX/0/,NCNT/0/,JMC/1554/,JMD/1380/
01250		IF(NEWEND.EQ.0)RETURN
01300		IF(NEWEND)GO TO 6002
01400		IF(NEWX)GO TO 1
01500		RTO=6
01600	CC	LSIDE=6
01700	CC	RSIDE=265
01800	CC	FLINE=20
01900	CC	LLINE=250
02000		NX=0
02100		NY=0
02200	
02300	1001	FORMAT(A1,3F)
02400	1000	FORMAT(' D, P, S, M OR T    HORZ.%,VRT.%,   ROTATION'/)
02500	6100	FORMAT(' INNER CLEAR AREA L-R-BT-TP%  OUTER L-R-B-T%
02600		1   REV=1, INV=1'/)
02700	6001	FORMAT(14F)
02800	1	CALL JZERO
02900		JX=0
03000		JY=0
03100		CONST=0
03200		TYPE 1000
03300		ACCEPT 1001,WHICH,RLR,RUD,ROT
03350		IF(WHICH.EQ.'R')RETURN
03375	C  TYPE 'R' TO GO BACK TO FILE TYPE-IN.
03400	CC	IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
03450		NCNT=NCNT+1
03500		REREAD 3,(INP(NA,NCNT),NA=1,10)
03800		IF(WHICH.NE.'H')GO TO 8002
03900		TYPE 9002
04000		GO TO 1
04100	9002	FORMAT(' D=DISPLAY, P=PLOT, S=SAVE FOR DRAWING PROG.'/
04200		1 ' M=MOVE, T=TYPE MY INPUT BACK.'/)
04300	8002	IF(WHICH.NE.'T')GO TO 3002
04310	6002	TYPE 91,RDIV,JJX
04320	91	FORMAT(' CENTR=',F6.2,'   STEP=',I2)
04400		DO 4002 K=1,NCNT
04500	4002	TYPE 5002,(INP(NA,K),NA=1,10)
04600		IF(NEWEND)RETURN
04700		GO TO 1000
04705	3002	IF(WHICH.EQ.'M')GO TO 3102
04710		TYPE 6100
04720		ACCEPT 6001,A,B,C,D,E,F,G,H,REV,RINV,P,Q,R,S
04730	C  TYPE -1 TO REPEAT LAST INPUT
04735		IF(A.GE.0)GO TO 33
04740	C  REPEATS LAST INPUT
04745		A=AA
04750		B=BB
04755		C=CC
04760		D=DD
04765		E=EE
04770		F=FF
04775		G=GG
04780		H=HH
04785		REV=RREV
04790		RINV=RRINV
04795		P=PP
04800		Q=QQ
04805		R=RR
04810		S=SS
04815	33	AA=A
04820		BB=B
04825		CC=C
04830		DD=D
04835		EE=E
04840		FF=F
04845		GG=G
04850		HH=H
04855		RREV=REV
04860		RRINV=RINV
04865		SS=S
04870		PP=P
04875		QQ=Q
04880		RR=R
04890		IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
04900		REREAD 3,(INP(NA,NCNT),NA=1,10)
05000	3102	JPL=3
05100		WX=WHICH
05200	C  SO IT WON'T COUNT RETRIES.
05300	3	FORMAT(10A5)
05400	5002	FORMAT(1X10A5)
05500	C  FAC=SIZE BY 100'S, RLR=LEFT-RIGHT SIZE, RUD=UP-DOWN SIZE
05600	C-- D 0 0    0,50,0,50 CLEARS LOWER LFT QUAD. 50 100 50 100 UPR RT.
05700	C  TYPE 'T' TO GET BACK ALL INPUT LINES.
05800		IF(A+B+C+D.EQ.0)A=-1.
05900	C 'N'= PLOT, BUT NO X
06000		IF(WHICH.NE.'S')GO TO 7002
06100		WHICH='P'
06200		CONST=-1
06300	7002	IF(WHICH.EQ.'M')GO TO 2002
06400		IF(E+H+F+G.EQ.0)E=-1.
06410		IF(P+Q+R+S.EQ.0)P=-1.
06500		IF(RLR.EQ.0)RLR=100.
06600		IF(RUD.EQ.0)RUD=100.
06700		IF(ROT.EQ.1)RINV=RINV-1
06800	2002	RLR=RLR/100.
06900		RUD=RUD/100.
07000		PLT=0
07100		IF(WHICH.NE.'D')GO TO 1002
07200	C  DPY IS 1/3 SIZE OF PLOT.
07300		GO TO 2000
07400	
07500	1102	IF(WHICH.NE.'M')GO TO 1
07600	C  MOVE PEN, L-R%, U-D
07700	2200	RX=JMC
07800		RY=JMD
07900		NX=RX*RLR
08000		NY=RY*RUD
08100		RLR=.01
08200		RUD=.01
08300		GO TO 67
08400	
08500	1002  IF(WHICH.NE.'P')GO TO 1102
08600		PLT=1
08700	
08800	2000	IF(NEWEND.GT.1000) PAUSE 'NEWEND>1000'
08900	67	MA=0
09000		MB=0
09100		MC=(RSIDE-LSIDE)*RTO*RLR+.5
09200		MD=(LLINE-FLINE)*RTO*RUD+.5
09210		JREV=MC/JPL
09255		JINV=MD/JPL
09300		JM=-380
09400		KM=-200
09500		IF(NEWX)GO TO 655
09600		JMC=MC
09700		JMD=MD
09800	655	JQX=NX
09900		JQY=NY
10000		IF(WHICH.EQ.'M')GO TO 671
10100		TYPE 657
10200	657	FORMAT(' OUTER LIMITS')
10300		TYPE 65,MA,MC,MB,MD
10400	C   OUTER COORDINATES
10500	CC	JREV=(JA+JC)/JPL
10600	C	JINV=(JB+JD)/JPL
10700		KA=0
10800		KB=0
10900		KC=0
11000		KD=0
11010		KP=0
11032		KQ=0
11054		KR=0
11076		KS=0
11100		IA=-1
11200		IB=99999
11300		IC=-1
11400		ID=99999
12100	671	IF(NEWX.NE.-1)CALL DPYSET(1,IDP1,4000)
12200		CALL SETPOG(1)
12300		CALL TYPLOC(-300,-611)
12400		CALL DPYBRT(6)
12500		JX=NX/JPL
12600		JY=NY/JPL
12700		CALL AIVECT(-380,-200)
12800	672	JA=0
12900		JB=0
13000		NC=MC/JPL
13100		ND=MD/JPL
13150		CALL DSTORT(JPL)
13200		CALL LINES(3)
13300	CC	CALL JZERO
13400		JA=NC
13500		JB=0
13600		CALL LINES(2)
13700		JA=NC
13800		JB=ND
13900		CALL LINES(2)
14000		JB=ND
14100		JA=0
14200		CALL LINES(2)
14300		JA=0
14400		JB=0
14500		CALL LINES(2)
14600		CALL DPYOUT(1)
14700		IF(WHICH.NE.'M')GO TO 2683
14800	168	NY=JQY
14900		NX=JQX
15000		GO TO 1
15100	2683	NQ=0
15200		IF(A)GO TO 1683
15300		KA=MC*(A/100.)
15400		KB=MC*(B/100.)
15500		KC=MD*(C/100.)
15600		KD=MD*(D/100.)
15800		CALL INVIS(KA,KB,KC,KD,NQ)
16000	1683	IF(P)GO TO 9683
16055		KP=MC*(P/100.)
16110		KQ=MC*(Q/100.)
16165		KR=MD*(R/100.)
16220		KS=MD*(S/100.)
16275		CALL INVIS(KP,KQ,KR,KS,NQ)
16330	9683	IF(E)GO TO 8683
16385		IA=MC*(E/100.)
16440		IB=MC*(F/100.)
16495		IC=MD*(G/100.)
16550		ID=MD*(H/100.)
16605		CALL INVIS(IA,IB,IC,ID,NQ)
16660		IF(PLT.EQ.0)E=-1
16715	8683	IF(PLT.NE.0)JPL=1
16770		KA=KA/JPL
16825		KB=KB/JPL
16880		KC=KC/JPL
16935		KD=KD/JPL
16990		KP=KP/JPL
17045		KQ=KQ/JPL
17100		KR=KR/JPL
17155		KS=KS/JPL
17210		IA=IA/JPL
17232		IB=IB/JPL
17254		IC=IC/JPL
17276		ID=ID/JPL
17300		TYPE 683
17400	683	FORMAT(' OK?'/)
17500		ACCEPT 1001,NA
17600		IF(NA.EQ.'N')GO TO 168
17700		JX=NX/JPL
17800		JY=NY/JPL
17900		IF(PLT.NE.0)GO TO 1681
18000	6852	CALL CLRPOG(2)
18100		CALL SETPOG(1)
18200	CC	JA=-380
18300	CC	JB=-200
18400		CALL JZERO
18500		CALL AIVECT(-380,-200)
18600		GO TO 685
18700	50	FORMAT(' DO YOU WANT THE FRAME ?'/)
18800	1681	TYPE 50
18900	65	FORMAT(' LFT=',I4,'   RT=',I4,'   BOT=',I4,'   TOP=',I4)
19000		ACCEPT 1001,ALFAB
19100	CC2	IF(WHICH.EQ.'N')GO TO 681
19200		IF(NEWX.NE.-1)CALL PLOTS(I)
19900	681	PLT=-1
20000		IF(ALFAB.NE.'Y') GOTO 685
20100		JX=NX
20200		JY=NY
20300		JA=0
20400		JB=0
20410		CALL DSTORT(JPL)
20500		CALL LINES(3)
20600		JA=MC
20700		JB=0
20800		CALL LINES(2)
20900		JA=MC
21000		JB=MD
21100		CALL LINES(2)
21200		JA=0
21300		JB=MD
21400		CALL LINES(2)
21500		JA=0
21600		JB=0
21700		CALL LINES(2)
21800	685	JAR=0
21900		JBR=0
22200		JREV=MC/JPL
22300		JINV=MD/JPL
22400		IF(CONST)PLT=-2
22410		CALL DSTORT(JPL)
22500		CALL PLTMAN
22600		NEWX=-1
22700		NX=JQX
22800		NY=JQY
22900		WX=0
23000		IF(PLT)CALL PLOT(0,0,3)
23050		NEWEND=0
23100		END